home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / [_a_3d_rac1854832192005.psc / cls2dPicture.cls < prev    next >
Text File  |  2005-02-19  |  6KB  |  165 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "cls2dPicture"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private Vert(3) As TLVertex
  17. Private NoRotVert(3) As TLVertex
  18. Private RotAngle As Single
  19. Private MP As D3DVECTOR2
  20. Private alpha As Byte, red As Byte, green As Byte, blue As Byte
  21.  
  22.  
  23. Private Sub Class_Initialize()
  24.     Dim Col As Long
  25.  
  26.     alpha = 255
  27.     red = 255
  28.     green = 255
  29.     blue = 255
  30.     Col = ColorMake(255, 255, 255)
  31.     Vert(0) = TLVertexMake(0, 0, Col, 0, 0)
  32.     Vert(1) = TLVertexMake(0, 0, Col, 1, 0)
  33.     Vert(2) = TLVertexMake(0, 0, Col, 0, 1)
  34.     Vert(3) = TLVertexMake(0, 0, Col, 1, 1)
  35. End Sub
  36.  
  37. '//-----------------------------------------------------------------------------
  38. '// Function: SetPosition
  39. '// Desc: Sets the position of the picture on the screen.
  40. '// Param: x1, y1 (the upper left corner), x2, y2 (the lower right corner)
  41. '// Note: This function makes a rotation undone.
  42. '//-----------------------------------------------------------------------------
  43. Public Sub SetPosition(ByVal x1 As Long, ByVal y1 As Long, ByVal x2 As Long, ByVal y2 As Long)
  44.     Vert(0).x = x1
  45.     Vert(0).y = y1
  46.     Vert(1).x = x2
  47.     Vert(1).y = y1
  48.     Vert(2).x = x1
  49.     Vert(2).y = y2
  50.     Vert(3).x = x2
  51.     Vert(3).y = y2
  52.     CopyMemory NoRotVert(0), Vert(0), 4 * Len(Vert(0))          'NoRotVert = Vert
  53.     MP = Vector2dMake((x1 + x2) / 2, (y1 + y2) / 2)
  54. End Sub
  55.  
  56. '//-----------------------------------------------------------------------------
  57. '// Function: Move
  58. '// Desc: Moves the picture on the screen.
  59. '// Param: MoveX, MoveY (the relative movement)
  60. '//-----------------------------------------------------------------------------
  61. Public Sub Move(ByVal MoveX As Long, ByVal MoveY As Long)
  62.     Dim i As Long
  63.  
  64.     For i = 0 To 3
  65.         Vert(i).x = Vert(i).x + MoveX
  66.         Vert(i).y = Vert(i).y + MoveY
  67.     Next i
  68. End Sub
  69.  
  70. '//-----------------------------------------------------------------------------
  71. '// Function: Rotate
  72. '// Desc: Rotates the picture clockwise around its centre.
  73. '//-----------------------------------------------------------------------------
  74. Public Sub Rotate(ByVal Angle As Single)
  75.     Dim i As Long
  76.     Dim cosPhi As Single, sinPhi As Single
  77.  
  78.     RotAngle = RotAngle + Angle
  79.     cosPhi = Cos(RotAngle)
  80.     sinPhi = Sin(RotAngle)
  81.     For i = 0 To 3
  82.         Vert(i).x = (NoRotVert(i).x - MP.x) * cosPhi - (NoRotVert(i).y - MP.y) * sinPhi + MP.x
  83.         Vert(i).y = (NoRotVert(i).x - MP.x) * sinPhi + (NoRotVert(i).y - MP.y) * cosPhi + MP.y
  84.     Next i
  85. End Sub
  86.  
  87. '//-----------------------------------------------------------------------------
  88. '// Function: SetPictureRange
  89. '// Desc: Defines the shown range of a texture on this picture.
  90. '// Param: x1, y1 (the upper left corner), x2, y2 (the lower right corner)
  91. '// Note: Pass [0, 0] and [1, 1] to show the entire texture.
  92. '//-----------------------------------------------------------------------------
  93. Public Sub SetPictureRange(ByVal x1 As Single, ByVal y1 As Single, ByVal x2 As Single, ByVal y2 As Single)
  94.     Vert(0).tu = x1
  95.     Vert(0).tv = y1
  96.     Vert(1).tu = x2
  97.     Vert(1).tv = y1
  98.     Vert(2).tu = x1
  99.     Vert(2).tv = y2
  100.     Vert(3).tu = x2
  101.     Vert(3).tv = y2
  102. End Sub
  103.  
  104. '//-----------------------------------------------------------------------------
  105. '// Function: SetBackcolor
  106. '// Desc: Sets the background color for this picture.
  107. '// Param: r, g, b
  108. '//-----------------------------------------------------------------------------
  109. Public Sub SetBackcolor(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
  110.     Dim i As Long, Col As Long
  111.  
  112.     red = r
  113.     green = g
  114.     blue = b
  115.     Col = ColorAlphaMake(alpha, red, green, blue)
  116.     For i = 0 To 3
  117.         Vert(i).Color = Col
  118.     Next i
  119. End Sub
  120.  
  121. '//-----------------------------------------------------------------------------
  122. '// Function: SetTransparency
  123. '// Desc: Sets the transparency for this picture.
  124. '// Param: Transparency (from 0 to 255)
  125. '//-----------------------------------------------------------------------------
  126. Public Sub SetTransparency(ByVal Transparency As Byte)
  127.     Dim i As Long, Col As Long
  128.  
  129.     alpha = 255 - Transparency
  130.     Col = ColorAlphaMake(alpha, red, green, blue)
  131.     For i = 0 To 3
  132.         Vert(i).Color = Col
  133.     Next i
  134. End Sub
  135.  
  136. '//-----------------------------------------------------------------------------
  137. '// Function: Render
  138. '// Desc: Renders the 2d picture.
  139. '// Param: Tex (the texture which should be used)
  140. '//-----------------------------------------------------------------------------
  141. Public Sub Render(Tex As cls2dTexture)
  142.     On Local Error GoTo Failed
  143.     
  144.     Dim UseTrans As Boolean, UseKey As Boolean
  145.  
  146.     UseTrans = IIf(alpha = 255, False, True)
  147.     UseKey = IIf(Tex.getColKey = 0, False, True)
  148.     gD3DDevice.SetVertexShader TL_FVF
  149.     If UseTrans Or UseKey Then
  150.         'A blending operation is required. So, enable alpha blending.
  151.         gD3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, True
  152.         If UseTrans And UseKey Then
  153.             gD3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_MODULATE
  154.         ElseIf UseTrans Then
  155.             gD3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG1
  156.         Else
  157.             gD3DDevice.SetTextureStageState 0, D3DTSS_ALPHAOP, D3DTOP_SELECTARG2
  158.         End If
  159.     End If
  160.     gD3DDevice.SetTexture 0, Tex.getpTexture
  161.     gD3DDevice.DrawPrimitiveUP D3DPT_TRIANGLESTRIP, 2, Vert(0), Len(Vert(0))
  162.     gD3DDevice.SetRenderState D3DRS_ALPHABLENDENABLE, False
  163. Failed:
  164. End Sub
  165.